home *** CD-ROM | disk | FTP | other *** search
/ Amiga Tools 2 / Amiga Tools 2.iso / tools / jade / src / commands.c < prev    next >
C/C++ Source or Header  |  1995-03-09  |  16KB  |  575 lines
  1. /* commands.c -- Interactive calling of commands/functions
  2.    Copyright (C) 1994 John Harper <jsh@ukc.ac.uk>
  3.  
  4.    This file is part of Jade.
  5.  
  6.    Jade is free software; you can redistribute it and/or modify it
  7.    under the terms of the GNU General Public License as published by
  8.    the Free Software Foundation; either version 2, or (at your option)
  9.    any later version.
  10.  
  11.    Jade is distributed in the hope that it will be useful, but
  12.    WITHOUT ANY WARRANTY; without even the implied warranty of
  13.    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14.    GNU General Public License for more details.
  15.  
  16.    You should have received a copy of the GNU General Public License
  17.    along with Jade; see the file COPYING. If not, write to
  18.    the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
  19.  
  20. #include "jade.h"
  21. #include "jade_protos.h"
  22.  
  23. #include <string.h>
  24.  
  25. _PR void commands_init(void);
  26.  
  27. /* Symbols of the Lisp functions called to get input. */
  28. static VALUE sym_prompt_for_function, sym_prompt_for_buffer,
  29.     sym_prompt_for_char, sym_prompt_for_command, sym_prompt_for_directory,
  30.     sym_prompt_for_file, sym_prompt_for_number, sym_prompt_for_string,
  31.     sym_prompt_for_symbol, sym_prompt_for_variable, sym_prompt_for_lisp,
  32.     sym_read_event;
  33.  
  34. static VALUE sym_interactive;
  35.  
  36. /* Prefix argument for the next command and the current command. */
  37. static VALUE prefix_arg, current_prefix_arg;
  38.  
  39. /* Command being executed and command last executed. */
  40. _PR VALUE this_command, last_command;
  41. VALUE this_command, last_command;
  42.  
  43. _PR VALUE var_this_command(VALUE val);
  44. DEFUN("this-command", var_this_command, subr_this_command, (VALUE val), V_Var, DOC_this_command) /*
  45. ::doc:this_command::
  46. This variable holds the command currently being evaluated, or nil if no
  47. command is active. The `command' is whatever is being evaluated; it could
  48. be a function, a form or even a list of forms (from a menu).
  49. ::end:: */
  50. {
  51.     if(val)
  52.     this_command = val;
  53.     return(this_command);
  54. }
  55.  
  56. _PR VALUE var_last_command(VALUE val);
  57. DEFUN("last-command", var_last_command, subr_last_command, (VALUE val), V_Var, DOC_last_command) /*
  58. ::doc:last_command::
  59. This variable holds the last interactive command evaluated. This will either
  60. be from a keybinding or a menu. Setting the value of the `next-keymap-path'
  61. variable is not considered a command. After a command finishes this variable
  62. takes the value of `this-command'.
  63. ::end:: */
  64. {
  65.     if(val)
  66.     last_command = val;
  67.     return(last_command);
  68. }
  69.  
  70. _PR VALUE var_prefix_arg(VALUE val);
  71. DEFUN("prefix-arg", var_prefix_arg, subr_prefix_arg, (VALUE val), V_Var, DOC_prefix_arg) /*
  72. ::doc:prefix_arg::
  73. Value of the prefix argument for the next command.
  74. ::end:: */
  75. {
  76.     if(val)
  77.     prefix_arg = val;
  78.     return(prefix_arg);
  79. }
  80.  
  81. _PR VALUE var_current_prefix_arg(VALUE val);
  82. DEFUN("current-prefix-arg", var_current_prefix_arg, subr_current_prefix_arg, (VALUE val), V_Var, DOC_current_prefix_arg) /*
  83. ::doc:current_prefix_arg::
  84. Value of the prefix argument for the current command.
  85. ::end:: */
  86. {
  87.     if(val)
  88.     current_prefix_arg = val;
  89.     return(current_prefix_arg);
  90. }
  91.  
  92. /* Search the definition of the command CMD for an interactive calling
  93.    spec. Return it or NULL. */
  94. static VALUE
  95. interactive_spec(VALUE cmd)
  96. {
  97.     VALUE fun, spec = NULL;
  98.     if(SYMBOLP(cmd))
  99.     fun = cmd_symbol_function(cmd, sym_t);
  100.     else
  101.     fun = cmd;
  102.     if(!VOIDP(fun) && !NILP(fun))
  103.     {
  104.     if((VTYPE(fun) >= V_Subr0) && (VTYPE(fun) <= V_SubrN))
  105.         spec = VSUBR(fun)->subr_IntSpec;
  106.     else if(CONSP(fun))
  107.     {
  108.         if(VCAR(fun) == sym_autoload)
  109.         {
  110.         VALUE tmp = move_down_list(fun, 2);
  111.         if(CONSP(tmp) && !NILP(VCAR(tmp)))
  112.         {
  113.             GCVAL gcv_cmd;
  114.             PUSHGC(gcv_cmd, cmd);
  115.             fun = load_autoload(cmd, fun);
  116.             POPGC;
  117.             if(!fun || !CONSP(fun))
  118.             return(NULL);
  119.         }
  120.         else
  121.             return(NULL);
  122.         }
  123.         if(VCAR(fun) == sym_lambda)
  124.         {
  125.         /* A lambda expression, test its first proper form. */
  126.         fun = move_down_list(fun, 2);
  127.         if(CONSP(fun)
  128.            && (STRINGP(VCAR(fun)) || NUMBERP(VCAR(fun)))
  129.            && CONSP(VCDR(fun)))
  130.         {
  131.             /* A doc-string */
  132.             fun = VCDR(fun);
  133.         }
  134.         if(CONSP(fun))
  135.         {
  136.             fun = VCAR(fun);
  137.             if(CONSP(fun)
  138.                && (VCAR(fun) == sym_interactive))
  139.             {
  140.             /* got it. */
  141.             spec = CONSP(VCDR(fun)) ? VCAR(VCDR(fun)) : sym_nil;
  142.             }
  143.         }
  144.         }
  145.     }
  146.     }
  147.     return(spec);
  148. }
  149.  
  150. _PR VALUE cmd_call_command(VALUE cmd, VALUE arg);
  151. DEFUN_INT("call-command", cmd_call_command, subr_call_command, (VALUE cmd, VALUE cmd_arg), V_Subr2, DOC_call_command, "CEnter command:\nP") /*
  152. ::doc:call_command::
  153. call-command COMMAND [PREFIX-ARG]
  154.  
  155. Invoke the command COMMAND. This can be one of,
  156.  1. A symbol whose function value is to be called, the symbol must be of
  157.     type `commandp'; any interactive calling specification will be
  158.     used to find arguments to give to the function. (see `interactive')
  159.  2. A lambda-expression to call as a function name
  160.  3. A single Lisp form to be evaluated by eval
  161.  
  162. If PREFIX-ARG is non-nil it specifies the value of the COMMAND's
  163. current-prefix-arg. This is used in call-command's interactive spec so that
  164. any entered arg is given to the invoked COMMAND.
  165. ::end:: */
  166. {
  167.     VALUE res = NULL;
  168.     this_command = cmd;
  169.     if(last_command == sym_t)
  170.     undo_distinct();        /* last was an insertion */
  171.     undo_new_group();
  172.  
  173.     /* Move the prefix arg. */
  174.     if(NILP(cmd_arg))
  175.     cmd_arg = prefix_arg;
  176.     prefix_arg = sym_nil;
  177.     current_prefix_arg = cmd_arg;
  178.  
  179.     if(SYMBOLP(cmd) || (CONSP(cmd) && VCAR(cmd) == sym_lambda))
  180.     {
  181.     /* A named command; call it properly taking note of any interactive
  182.        declaration. */
  183.     VALUE int_spec = interactive_spec(cmd);
  184.     VALUE args = sym_nil;
  185.     VALUE *argsp = &args;
  186.     GCVAL gcv_cmd;
  187.     bool clear_block = FALSE;
  188.     if(int_spec == NULL)
  189.     {
  190.         cmd_signal(sym_error, list_2(MKSTR("Not a command"), cmd));
  191.         goto exit;
  192.     }
  193.     PUSHGC(gcv_cmd, cmd);
  194.     if(STRINGP(int_spec))
  195.     {
  196.         u_char *spec_str = VSTR(int_spec);
  197.         u_char c;
  198.         GCVAL gcv_args;
  199.         while(1)
  200.         {
  201.         /* check for read-only flag */
  202.         if(*spec_str == '*')
  203.         {
  204.             if(read_only(curr_vw->vw_Tx))
  205.             {
  206.             POPGC;
  207.             goto exit;
  208.             }
  209.             else
  210.             spec_str++;
  211.         }
  212.         else if(*spec_str == '-')
  213.         {
  214.             /* clear block after building args. */
  215.             clear_block = TRUE;
  216.             spec_str++;
  217.         }
  218.         else
  219.             break;
  220.         }
  221.         PUSHGC(gcv_args, args);
  222.         while((c = *spec_str++) != 0)
  223.         {
  224.         VALUE prompt, arg = sym_nil;
  225.         if(c != '\n')
  226.         {
  227.             /* Non-null code. */
  228.             bool can_be_nil = FALSE;
  229.             if(*spec_str == '\n')
  230.             {
  231.             /* no prompt */
  232.             prompt = sym_nil;
  233.             spec_str++;
  234.             }
  235.             else
  236.             {
  237.             /* copy the prompt */
  238.             u_char *end = memchr(spec_str, '\n',
  239.                          STRING_LEN(int_spec) -
  240.                          (spec_str - VSTR(int_spec)));
  241.             if(!end)
  242.                 end = VSTR(int_spec) + STRING_LEN(int_spec);
  243.             prompt = string_dupn(spec_str, end - spec_str);
  244.             if(memchr(spec_str, '%', end - spec_str))
  245.             {
  246.                 /* Format characters; format it. */
  247.                 prompt = cmd_format(cmd_cons(sym_nil,
  248.                              cmd_cons(prompt, args)));
  249.                 if(!prompt || !STRINGP(prompt))
  250.                 prompt = string_dupn(spec_str, end - spec_str);
  251.             }
  252.             spec_str = *end ? end + 1 : end;
  253.             }
  254.             switch(c)
  255.             {
  256.             case 'a':
  257.             arg = call_lisp1(sym_prompt_for_function, prompt);
  258.             break;
  259.             case 'b':
  260.             arg = call_lisp2(sym_prompt_for_buffer, prompt, sym_t);
  261.             break;
  262.             case 'B':
  263.             arg = call_lisp1(sym_prompt_for_buffer, prompt);
  264.             break;
  265.             case 'c':
  266.             arg = call_lisp1(sym_prompt_for_char, prompt);
  267.             break;
  268.             case 'C':
  269.             arg = call_lisp1(sym_prompt_for_command, prompt);
  270.             break;
  271.             case 'd':
  272.             arg = cmd_cursor_pos();
  273.             break;
  274.             case 'D':
  275.             arg = call_lisp1(sym_prompt_for_directory, prompt);
  276.             break;
  277.             case 'e':
  278.             arg = cmd_current_event();
  279.             break;
  280.             case 'E':
  281.             arg = cmd_current_event_string();
  282.             break;
  283.             case 'f':
  284.             arg = call_lisp2(sym_prompt_for_file, prompt, sym_t);
  285.             break;
  286.             case 'F':
  287.             arg = call_lisp1(sym_prompt_for_file, prompt);
  288.             break;
  289.             case 'k':
  290.             arg = call_lisp1(sym_read_event, prompt);
  291.             break;
  292.             case 'm':
  293.             case 'M':
  294.             arg = (c == 'm') ? cmd_block_start(sym_nil)
  295.                              : cmd_block_end(sym_nil);
  296.             if(!arg || NILP(arg))
  297.             {
  298.                 arg = NULL;
  299.                 cmd_signal(sym_error,
  300.                        LIST_1(MKSTR("No block marked")));
  301.             }
  302.             break;
  303.             case 'n':
  304.             arg = call_lisp1(sym_prompt_for_number, prompt);
  305.             break;
  306.             case 'N':
  307.             if(NILP(cmd_arg))
  308.                 arg = call_lisp1(sym_prompt_for_number, prompt);
  309.             else
  310.                 arg = cmd_prefix_numeric_argument(cmd_arg);
  311.             break;
  312.             case 'p':
  313.             arg = cmd_prefix_numeric_argument(cmd_arg);
  314.             break;
  315.             case 'P':
  316.             arg = cmd_arg;
  317.             can_be_nil = TRUE;
  318.             break;
  319.             case 's':
  320.             arg = call_lisp1(sym_prompt_for_string, prompt);
  321.             break;
  322.             case 'S':
  323.             arg = call_lisp1(sym_prompt_for_symbol, prompt);
  324.             can_be_nil = TRUE;
  325.             break;
  326.             case 't':
  327.             arg = sym_t;
  328.             break;
  329.             case 'v':
  330.             arg = call_lisp1(sym_prompt_for_variable, prompt);
  331.             break;
  332.             case 'x':
  333.             arg = call_lisp1(sym_prompt_for_lisp, prompt);
  334.             can_be_nil = TRUE;
  335.             break;
  336.             case 'X':
  337.             arg = call_lisp1(sym_prompt_for_lisp, prompt);
  338.             if(arg)
  339.                 arg = cmd_eval(arg);
  340.             can_be_nil = TRUE;
  341.             break;
  342.             default:
  343.             arg = NULL;
  344.             cmd_signal(sym_interactive, list_2(cmd, int_spec));
  345.             }
  346.             if(!arg)
  347.             {
  348.             args = NULL;
  349.             break;
  350.             }
  351.             if(!can_be_nil && NILP(arg))
  352.             {
  353.             cmd_signal(sym_error,
  354.                    list_2(MKSTR("Nil argument to command"),
  355.                       cmd));
  356.             args = NULL;
  357.             break;
  358.             }
  359.         }
  360.         /* Tack on this argument. */
  361.         *argsp = cmd_cons(arg, sym_nil);
  362.         argsp = &VCDR(*argsp);
  363.         }
  364.         POPGC;
  365.     }
  366.     else if(int_spec != sym_t)
  367.         args = cmd_eval(int_spec);
  368.     if(clear_block)
  369.         cmd_block_kill();
  370.     if(args)
  371.         res = funcall(cmd, args);
  372.     POPGC;
  373.     }
  374.     else
  375.     res = cmd_eval(cmd);
  376.  exit:
  377.     last_command = this_command;
  378.     /* This is in here so it can tell if the last binding was actually
  379.        a command. */
  380.     undo_distinct();
  381.     this_command = sym_nil;
  382.     current_prefix_arg = sym_nil;
  383.     return(res);
  384. }
  385.  
  386. _PR VALUE cmd_prefix_numeric_argument(VALUE arg);
  387. DEFUN("prefix-numeric-argument", cmd_prefix_numeric_argument, subr_prefix_numeric_argument, (VALUE arg), V_Subr1, DOC_prefix_numeric_argument) /*
  388. ::doc:prefix_numeric_argument::
  389. prefix-numeric-argument ARG
  390.  
  391. Returns the numeric value of the raw prefix argument ARG.
  392. ::end:: */
  393. {
  394.     switch(VTYPE(arg))
  395.     {
  396.     case V_Symbol:
  397.     arg = make_number(NILP(arg) ? 1 : -1);
  398.     break;
  399.     case V_Number:
  400.     break;
  401.     case V_Cons:
  402.     arg = VCAR(arg);
  403.     break;
  404.     default:
  405.     arg = make_number(1);
  406.     }
  407.     return(arg);
  408. }
  409.  
  410. _PR VALUE cmd_interactive(VALUE spec);
  411. DEFUN("interactive", cmd_interactive, subr_interactive, (VALUE arg_list), V_SF, DOC_interactive) /*
  412. ::doc:interactive::
  413. interactive CALLING-SPEC
  414.  
  415. This is a declaration used by the `call-command' function. For each Lisp
  416. function which may be invoked as a command (interactively by the user) the
  417. first *actual* form of the function (after the arguments and optional doc
  418. string) must be an `interactive' declaration. For example,
  419.  
  420. (defun foo (bar)
  421.   "An illustration"
  422.   (interactive ...)
  423.   ...
  424.  
  425. When called, the interactive special form just returns nil.
  426.  
  427. The CALLING-SPEC defines the arguments which are given to the command, it
  428. can be either,
  429.  
  430.  1. nil -- no arguments are given to the function, this is just used to show
  431.     that this function may be called as a command.
  432.  
  433.  2. A Lisp form -- it is evaluated and expected to provide a *list* of
  434.     arguments which will be given to the function
  435.  
  436.  3. A string -- zero or more lines (separated by `\n'); each line tells
  437.     how to get one argument. The first character of each line is a code
  438.     letter, the rest of the line is an optional prompt-string which the
  439.     user will see when entering the argument's value.
  440.  
  441.     The code letters available are,
  442.     a    A function
  443.     b    An existing buffer
  444.     B    A buffer, it will be created if it doesn't exist
  445.     c    A character
  446.     C    A command
  447.     d    The position of the cursor
  448.     D    The name of a directory
  449.     e    The event which caused this command
  450.     E    The event which caused this command as a string
  451.     f    The name of an existing file
  452.     F    The name of a file
  453.     k    An event
  454.     m    The start position of the currently-marked block
  455.     M    The end of the block
  456.     n    A number
  457.     N    The numeric prefix arg, or an entered number
  458.     p    The numeric prefix arg
  459.     P    The raw prefix arg
  460.     s    A string
  461.     S    A symbol
  462.     t    The symbol `t'
  463.     v    A variable
  464.     x    A Lisp object
  465.     X    A Lisp object, read then evaluated
  466.  
  467.     A null line produces an argument of nil.
  468.  
  469.     Any non-alphabetic characters at the beginning of the CALLING-SPEC
  470.     are used as flags, the currently recognised flags are,
  471.  
  472.     *    If the active buffer is read-only an error will be signalled
  473.     -    After building the argument list the block marked in the
  474.         current window will be unmarked.
  475.  
  476. Example usage,
  477.  
  478.     (interactive)            -- No arguments but function may
  479.                        be called as a command
  480.     (interactive "bBuffer to kill:")    -- One arg, an existing buffer
  481.     (interactive "*\nxLisp form:\nt")    -- If not read-only, three arguments;
  482.                        `nil', a lisp form and `t'.
  483. ::end:: */
  484. {
  485.     return(sym_nil);
  486. }
  487.  
  488. _PR VALUE cmd_commandp(VALUE cmd);
  489. DEFUN("commandp", cmd_commandp, subr_commandp, (VALUE cmd), V_Subr1, DOC_commandp) /*
  490. ::doc:commandp::
  491. commandp COMMAND
  492.  
  493. Returns t if COMMAND may be called interactively.
  494. ::end:: */
  495. {
  496.     if(SYMBOLP(cmd))
  497.     cmd = cmd_symbol_function(cmd, sym_t);
  498.     if(!VOIDP(cmd) && !NILP(cmd))
  499.     {
  500.     if(((VTYPE(cmd) >= V_Subr0) && (VTYPE(cmd) <= V_SubrN))
  501.        && (VSUBR(cmd)->subr_IntSpec != NULL))
  502.         return(sym_t);
  503.     else if(CONSP(cmd))
  504.     {
  505.         if(VCAR(cmd) == sym_autoload)
  506.         {
  507.         cmd = find_member_by_index(cmd, 3);
  508.         if(!NILP(cmd))
  509.             return(sym_t);
  510.         }
  511.         else if(VCAR(cmd) == sym_lambda)
  512.         {
  513.         /* A lambda expression, test its first proper form. */
  514.         cmd = move_down_list(cmd, 2);
  515.         if(CONSP(cmd)
  516.            && (STRINGP(VCAR(cmd)) || NUMBERP(VCAR(cmd)))
  517.            && CONSP(VCDR(cmd)))
  518.         {
  519.             /* A doc-string */
  520.             cmd = VCDR(cmd);
  521.         }
  522.         if(CONSP(cmd))
  523.         {
  524.             cmd = VCAR(cmd);
  525.             if(CONSP(cmd)
  526.                && (VCAR(cmd) == sym_interactive))
  527.             {
  528.             return(sym_t);
  529.             }
  530.         }
  531.         }
  532.     }
  533.     }
  534.     return(sym_nil);
  535. }
  536.     
  537. void
  538. commands_init(void)
  539. {
  540.     /* Create the function symbols. */
  541.     INTERN(sym_prompt_for_function, "prompt-for-function");
  542.     INTERN(sym_prompt_for_buffer, "prompt-for-buffer");
  543.     INTERN(sym_prompt_for_char, "prompt-for-char");
  544.     INTERN(sym_prompt_for_command, "prompt-for-command");
  545.     INTERN(sym_prompt_for_directory, "prompt-for-directory");
  546.     INTERN(sym_prompt_for_file, "prompt-for-file");
  547.     INTERN(sym_prompt_for_number, "prompt-for-number");
  548.     INTERN(sym_prompt_for_string, "prompt-for-string");
  549.     INTERN(sym_prompt_for_symbol, "prompt-for-symbol");
  550.     INTERN(sym_prompt_for_variable, "prompt-for-variable");
  551.     INTERN(sym_prompt_for_lisp, "prompt-for-lisp");
  552.     INTERN(sym_read_event, "read-event");
  553.  
  554.     INTERN(sym_interactive, "interactive");
  555.     cmd_put(sym_interactive, sym_error_message,
  556.         MKSTR("Bad interactive specification"));
  557.  
  558.     prefix_arg = current_prefix_arg = sym_nil;
  559.     mark_static(&prefix_arg);
  560.     mark_static(¤t_prefix_arg);
  561.  
  562.     this_command = last_command = sym_nil;
  563.     mark_static(&this_command);
  564.     mark_static(&last_command);
  565.  
  566.     ADD_SUBR(subr_this_command);
  567.     ADD_SUBR(subr_last_command);
  568.     ADD_SUBR(subr_prefix_arg);
  569.     ADD_SUBR(subr_current_prefix_arg);
  570.     ADD_SUBR(subr_call_command);
  571.     ADD_SUBR(subr_prefix_numeric_argument);
  572.     ADD_SUBR(subr_interactive);
  573.     ADD_SUBR(subr_commandp);
  574. }
  575.